SWAGOLX.EXE (c) 1993 GDSOFT ALL RIGHTS RESERVED 00020 MATH ROUTINES 1 05-28-9313:50ALL SWAG SUPPORT TEAM 3DPOINTS.PAS IMPORT 7 {π> Could someone please explain how to plot a 3-D points? How do you convertπ> a 3D XYZ value, to an XY value that can be plotted onto the screen?π}ππFunction x3d(x1, z1 : Integer) : Integer;πbeginπ x3d := Round(x1 - (z1 * Cos(Theta)));πend;ππFunction y3d(y1, z1 : Integer) : Integer;πbeginπ y3d := Round(y1 - (z1 * Sin(Theta)));πend;ππ{πSo a Function that plots a 3d pixel might look like this:ππProcedure plot3d(x, y, z : Integer);πbeginπ plot(x3d(x, z), y3d(y, z));πend;ππThe theta above is the angle on the screen on which your are "simulating"πyour z axis. This is simplistic, but should get you started. Just rememberπyou are simulating 3 dimensions on a 2 dimension media (the screen). Trigπhelps. ;-)π} 2 05-28-9313:50ALL SWAG SUPPORT TEAM CIRCLE3P.PAS IMPORT 28 Program ThreePoints_TwoPoints;π{ππ I Really appreciate ya helping me With this 3 points on aπcircle problem. The only thing is that I still can't get itπto work. I've tried the Program you gave me and it spits outπthe wrong answers. I don't know if there are parentheses in theπwrong place or what. Maybe you can find the error.π π You'll see that I've inserted True coordinates For this test.π πThank you once again...and please, when you get any more informationπon this problem...call me collect person to person or leave it on myπBBS. I get the turbo pascal echo from a California BBS and that sureπis long distance. Getting a good pascal Procedure For this isπimportant to me because I am using it in a soon to be released mathπProgram called Mr. Machinist! I've been racking my brain about thisπfor 2 weeks now and I've even been dream'in about it!π πYour help is appreciated!!!π π +π+AL+π π(716) 434-7823 Voiceπ(716) 434-1448 BBS ... if none of these, then leave Program on TP echo.π π}π πUsesπ Crt;πConstπ x1 = 4.0642982;π y1 = 0.9080732;π x2 = 1.6679862;π y2 = 2.8485684;π x3 = 4.0996421;π y3 = 0.4589868;ππVarπ Selection : Integer;πProcedure ThreePoints;πVarπ Slope1,π Slope2,π Mid1x,π Mid1y,π Mid2x,π Mid2y,π Cx,π Cy,π Radius : Real;πbeginπ ClrScr;π Writeln('3 points on a circle');π Writeln('====================');π Writeln;π Writeln('X1 -> 4.0642982');π Writeln('Y1 -> 0.9080732');π Writeln;π Writeln('X2 -> 1.6679862');π Writeln('Y2 -> 2.8485684');π Writeln('X3 -> 4.0996421');π Writeln('Y3 -> 0.4589868');π Writeln;π Slope1 := (y2 - y1) / (x2 - x1);π Slope2 := (y3 - y2) / (x3 - x2);π Mid1x := (x1 + x2) / 2;π Mid1y := (y1 + y2) / 2;π Mid2x := (x2 + x3) / 2;π Mid2y := (y2 + y3) / 2;π Slope1 := -1 * (1 / Slope1);π Slope2 := -1 * (1 / Slope2);π Cx := (Slope2 * x2 - y2 - Slope1 * x1 + y1) / (Slope1 - Slope2);π Cy := Slope1 * (Cx + x1) - y1;ππ {π I believe you missed out on using Cx and Cy in next line,π Radius := sqrt(((x1 - x2) * (x1 - x2)) + ((y1 - y2) * (y1 - y2)));π I think it should be . . .π }ππ Radius := Sqrt(Sqr((x1 - Cx) + (y1 - Cy)));π Writeln;π Writeln('X center line (Program answer) is ', Cx : 4 : 4);π Writeln('Y center line (Program answer) is ', Cy : 4 : 4);π Writeln('The radius (Program answer) is ', Radius : 4 : 4);π Writeln;π Writeln('True X center = 1.7500');π Writeln('True Y center = 0.5000');π Writeln('True Radius = 2.3500');π Writeln('Strike any key to continue . . .');π ReadKey;πend;ππProcedure Distance2Points;πVarπ x1, y1,π x2, y2,π Distance : Real;πbeginπ ClrScr;π Writeln('Distance between 2 points');π Writeln('=========================');π Writeln;π Write('X1 -> ');π Readln(x1);π Write('Y1 -> ');π Readln(y1);π Writeln;π Write('X2 -> ');π Readln(x2);π Write('Y2 -> ');π Readln(y2);π Writeln;π Writeln;π Distance := Sqrt((Sqr(x2 - x1)) + (Sqr(y2 - y1)));π Writeln('Distance between point 1 and point 2 = ', Distance : 4 : 4);π Writeln;π Writeln('Strike any key to continue . . .');ππ ReadKey;πend;ππbeginπ ClrScr;π Writeln;π Writeln;π Writeln('1) Distance between 2 points');π Writeln('2) 3 points on a circle test Program');π Writeln('0) Quit');π Writeln;π Write('Choose a menu number: ');π Readln(Selection);π Case Selection ofπ 1 : Distance2Points;π 2 : ThreePoints;π end;π ClrScr;πend.π 3 05-28-9313:50ALL SWAG SUPPORT TEAM EQUATE.PAS IMPORT 29 { Author: Gavin Peters. }ππProgram PostFixConvert;π(*π * This Program will convert a user entered expression to postfix, andπ * evaluate it simultaniously. Written by Gavin Peters, based slightlyπ * on a stack example given in Algorithms (Pascal edition), pgπ *π *)πVarπ Stack : Array[1 .. 3] of Array[0 .. 500] of LongInt;ππProcedure Push(which : Integer; p : LongInt);πbeginπ Stack[which,0] := Stack[which,0]+1;π Stack[which,Stack[which,0]] := pπend;ππFunction Pop(which : Integer) : LongInt;πbeginπ Pop := Stack[which,Stack[which,0]];π Stack[which,0] := Stack[which,0]-1πend;ππVarπ c : Char;π x,t,π bedmas : LongInt;π numbers : Boolean;ππProcedure Evaluate( ch : Char );ππ Function Power( exponent, base : LongInt ) : LongInt;π beginπ if Exponent > 0 thenπ Power := Base*Power(exponent-1, base)π ELSEπ Power := 1π end;ππbeginπ Write(ch);π if Numbers and not (ch = ' ') thenπ x := x * 10 + (Ord(c) - Ord('0'))π ELSEπ beginπ Case ch OFπ '*' : x := pop(2)*pop(2);π '+' : x := pop(2)+pop(2);π '-' : x := pop(2)-pop(2);π '/' : x := pop(2) div pop(2);π '%' : x := pop(2) MOD pop(2);π '^' : x := Power(pop(2),pop(2));π 'L' : x := pop(2) SHL pop(2);π 'R' : x := pop(2) SHR pop(2);π '|' : x := pop(2) or pop(2);π '&' : x := pop(2) and pop(2);π '$' : x := pop(2) xor pop(2);π '=' : if pop(2) = pop(2) thenπ x := 1π elseπ x := 0;π '>' : if pop(2) > pop(2) thenπ x := 1π elseπ x := 0;π '<' : if pop(2) < pop(2) thenπ x := 1π elseπ x := 0;π '0','1'..'9' :π beginπ Numbers := True;π x := Ord(c) - Ord('0');π Exitπ end;π ' ' : if not Numbers thenπ Exit;π end;ππ Numbers := False;π Push(2,x);π end;πend;ππbeginπ Writeln('Gavin''s calculator, version 1.00');π Writeln;π For x := 1 to 3 DOπ Stack[x, 0] := 0;π x := 0;π numbers := False;π Bedmas := 50;π Writeln('Enter an expression in infix:');π Repeatπ Read(c);π Case c OFπ ')' :π beginπ Bedmas := Pop(3);π Evaluate(' ');π Evaluate(Chr(pop(1)));π end;ππ '^','%','+','-','*','/','L','R','|','&','$','=','<','>' :π beginπ t := bedmas;π Case c Ofππ '>','<' : bedmas := 3;π '|','$',π '+','-' : bedmas := 2;π '%','L','R','&',π '*','/' : bedmas := 1;π '^' : bedmas := 0;π end;π if t <= bedmas thenπ beginπ Evaluate(' ');π Evaluate(Chr(pop(1)));π end;π Push(1,ord(c));π Evaluate(' ');π end;π '(' :π beginπ Push(3,bedmas);π bedmas := 50;π end;π '0','1'..'9' : Evaluate(c);π end;ππ Until Eoln;ππ While Stack[1,0] <> 0 DOπ beginπ Evaluate(' ');π Evaluate(Chr(pop(1)));π end;π Evaluate(' ');π Writeln;π Writeln;π Writeln('The result is ',Pop(2));πend.ππ{πThat's it, all. This is an evaluator, like Reuben's, With a fewπmore features, and it's shorter.ππOkay, there it is (the above comment was in the original post). I'veπnever tried it, but it looks good. :-) BTW, if it does work you mightπwant to thank Gavin Peters... after all, he wrote it. I was justπinterested when I saw it, and stored it along With a bunch of otherπsource-code tidbits I've git here...π}π 4 05-28-9313:50ALL SWAG SUPPORT TEAM FIBONACC.PAS IMPORT 5 {π>The problem is to Write a recursive Program to calculate Fibonacci numbers.π>The rules For the Fibonacci numbers are:π>π> The Nth Fib number is:π>π> 1 if N = 1 or 2π> The sum of the previous two numbers in the series if N > 2π> N must always be > 0.π}ππFunction fib(n : LongInt) : LongInt;πbeginπ if n < 2 thenπ fib := nπ elseπ fib := fib(n - 1) + fib(n - 2);πend;ππVarπ Count : Integer;ππbeginπ Writeln('Fib: ');π For Count := 1 to 15 doπ Write(Fib(Count),', ');πend. 5 05-28-9313:50ALL SWAG SUPPORT TEAM GAUSS.PAS IMPORT 121 Program Gauss_Elimination;ππUses Crt,Printer;ππ(***************************************************************************)π(* STEPHEN ABRAHAM *)π(* MCEN 3030 Comp METHODS *)π(* ASSGN #3 *)π(* DUE: 2-12-93 *)π(* *)π(* GAUSS ELIMinATION (TURBO PASCAL VERSION by STEPHEN ABRAHAM) *)π(* *)π(***************************************************************************)π{ }π{ }π{------------------VarIABLE DECLARATION and DEFinITIONS--------------------}ππConstπ MAXROW = 50; (* Maximum # of rows in a matrix *)π MAXCOL = 50; (* Maximum # of columns in a matrix *)ππTypeπ Mat_Array = Array[1..MAXROW,1..MAXCOL] of Real; (* 2-D Matrix of Reals *)π Col_Array = Array[1..MAXCOL] of Real; (* 1-D Matrix of Real numbers *)π Int_Array = Array[1..MAXCOL] of Integer; (* 1-D Matrix of Integers *)ππVarπ N_EQNS : Integer; (* User Input : Number of equations in system *)π COEFF_MAT : Mat_Array; (* User Input : Coefficient Matrix of system *)π COL_MAT : Col_Array; (* User Input : Column matrix of Constants *)π X_MAT : Col_Array; (* OutPut : Solution matrix For unknowns *)π orDER_VECT : Int_Array; (* Defined to pivot rows where necessary *)π SCALE_VECT : Col_Array; (* Defined to divide by largest element in *)π (* row For normalizing effect *)π I,J,K : Integer; (* Loop control and Array subscripts *)π Ans : Char; (* Yes/No response to check inputted matrix *)πππ{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}ππππ{^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^}π{>>>>>>>>>>>>>>>>>>>>>>>>> ProcedureS <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<}π{...........................................................................}πππProcedure Home; (* clears screen and positions cursor at (1,1) *)πbeginπ ClrScr;π GotoXY(1,1);πend; (* Procedure Home *)ππ{---------------------------------------------------------------------------}πππProcedure Instruct; (* provides user instructions if wanted *)ππVarπ Ans : Char; (* Yes/No answer by user For instructions or not *)ππbeginπ Home; (* calls Home Procedure *)π GotoXY(22,8); Writeln('STEVE`S GAUSSIAN ELIMinATION Program');π GotoXY(36,10); Writeln('2-12-92');π GotoXY(31,18); Write('Instructions(Y/N):');π GotoXY(31,49); readln(Ans);π if Ans in ['Y','y'] thenπ beginπ Home; (* calls Home Procedure *)π Writeln(' Welcome to Steve`s Gaussian elimination Program. With this');π Writeln('Program you will be able to enter the augmented matrix of ');π Writeln('your system of liNear equations and have returned to you the ');π Writeln('solutions For each unknown. The Computer will ask you to ');π Writeln('input the number of equations in your system and will then ');π Writeln('have you input your coefficient matrix and then your column ');π Writeln('matrix. Please remember For n unknowns, you will need to ');π Writeln('have n equations. ThereFore you should be entering a square ');π Writeln('(nxn) coefficient matrix. Have FUN!!!! ');π Writeln('(hit <enter> to continue...)'); (* Delay *)π readln;π end;πend;πππ{---------------------------------------------------------------------------}πππProcedure Initialize_Array( Var Coeff_Mat : Mat_Array ;π Var Col_Mat,X_Mat, Scale_Vect : Col_Array;π Var order_Vect : Int_Array);ππ(*** This Procedure initializes all matrices to be used in Program ***)π(*** ON ENTRY : Matrices have undefined values in them ***)π(*** ON Exit : All Matrices are zero matrices ***)πππConstπ MAXROW = 50; { maximum # of rows in matrix }π MAXCOL = 50; { maximum # of columns in matrix }ππVarπ I : Integer; { I & J are both loop control and Array subscripts }π J : Integer;ππbeginπ For I := 1 to MaxRow do { row indices }π beginπ Col_Mat[I] := 0;π X_Mat[I] := 0;π order_Vect[I] := 0;π Scale_Vect[I] := 0;π For J := 1 to MaxCol do { column indices }π Coeff_Mat[I,J] := 0;π end;πend; (* Procedure initialize_Array *)πππ{---------------------------------------------------------------------------}ππProcedure Input(Var N : Integer;π Var Coeff_Mat1 : Mat_Array;π Var Col_Mat1 : Col_Array);ππ(*** This Procedure lets the user input the number of equations and the ***)π(*** augmented matrix of their system of equations ***)π(*** ON ENTRY : N => number of equations : UNDEFinEDπ Coeff_Mat1 => coefficient matrix : UNDEFinEDπ Col_Mat1 => column matrix :UNDEFinEDπ ON Exit : N => # of equations input by userπ Coeff_Mat1 => defined coefficient matrixπ Col_Mat1 => defined column matrix input by user ***)ππππVarπ I,J : Integer; (* loop control and Array indices *)ππbeginπ Home; (* calls Procedure Home *)π Write('Enter the number of equations in your system: ');π readln(N);π Writeln;π Writeln('Now you will enter your coefficient and column matrix:');π For I := 1 to N do { row indice }π beginπ Writeln('ROW #',I);π For J := 1 to N do {column indice }π beginπ Write('a(',I,',',J,'):');π readln(Coeff_Mat1[I,J]); {input of coefficient matrix}π end;π Write('c(',I,'):');π readln(Col_Mat1[I]); {input of Constant matrix}π end;π readln;πend; (* Procedure Input *)πππ{---------------------------------------------------------------------------}πππProcedure Check_Input( Coeff_Mat1 : Mat_Array;π N : Integer; Var Ans : Char);ππ(*** This Procedure displays the user's input matrix and asks if it is ***)π(*** correct. ***)π(*** ON ENTRY : Coeff_Mat1 => inputted matrixπ N => inputted number of equationsπ Ans => UNDEFinED ***)π(*** ON Exit : Coeff_Mat1 => n/aπ N => n/aπ Ans => Y,y or N,n ***)πππVarπ I,J : Integer; (* loop control and Array indices *)ππbeginπ Home; (* calls Home Procedure *)π Writeln; Writeln('Your inputted augmented matrix is:');Writeln;Writeln;ππ For I := 1 to N do { row indice }π beginπ For J := 1 to N do { column indice }π Write(Coeff_Mat[I,J]:12:4);π Writeln(Col_Mat[I]:12:4);π end;π Writeln; Write('Is this your desired matrix?(Y/N):'); (* Gets Answer *)π readln(Ans);πend; (* Procedure Check_Input *)πππ{---------------------------------------------------------------------------}πππProcedure order(Var Scale_Vect1 : Col_Array;π Var order_Vect1 : Int_Array;π Var Coeff_Mat1 : Mat_Array;π N : Integer);ππ(*** This Procedure finds the order and scaling value For each row of theπ inputted coefficient matrix. ***)π(*** ON ENTRY : Scale_Vect1 => UNDEFinEDπ order_Vect1 => UNDEFinEDπ Coeff_Mat1 => as inputtedπ N => # of equationsπ ON Exit : Scale_Vect1 => contains highest value For each row of theπ coefficient matrixπ order_Vect1 => is assigned the row number of each row fromπ the coefficient matrix in orderπ Coeff_Mat => n/aπ N => n/a ***)πππVarπ I,J : Integer; {loop control and Array indices}ππbeginπFor I := 1 to N doπ beginπ order_Vect1[I] := I; (* ordervect gets the row number of each row *)π Scale_Vect1[I] := Abs(Coeff_Mat1[I,1]); (* gets the first number of each row *)π For J := 2 to N do { goes through the columns }π begin (* Compares values in each row of the coefficient matrix andπ stores this value in scale_vect[i] *)π if Abs(Coeff_Mat1[I,J]) > Scale_Vect1[I] thenπ Scale_Vect1[I] := Abs(Coeff_Mat1[I,J]);π end;π end;πend; (* Procedure order *)πππ{---------------------------------------------------------------------------}πππProcedure Pivot(Var Scale_Vect1 : Col_Array;π Coeff_Mat1 : Mat_Array;π Var order_Vect1 : Int_Array;π K,N : Integer);ππ(*** This Procedure finds the largest number in each column after it has beenπ scaled and Compares it With the number in the corresponding diagonalπ position. For example, in column one, a(1,1) is divided by the scalingπ factor of row one. then each value in the matrix that is in column oneπ is divided by its own row's scaling vector and Compared With theπ position above it. So a(1,1)/scalevect[1] is Compared to a[2,1]/scalevect[2]π and which ever is greater has its row number stored as pivot. Once theπ highest value For a column is found, rows will be switched so that theπ leading position has the highest possible value after being scaled. ***)ππ(*** ON ENTRY : Scale_Vect1 => the normalizing value of each rowπ Coeff_Mat1 => the inputted coefficient matrixπ order_Vect1 => the row number of each row in original orderπ K => passed in from the eliminate Procedureπ N => number of equationsπ ON Exit : Scale_Vect => sameπ Coeff_Mat1 => sameπ order_Vect => contains the row number With highest scaledπ valueπ k => n/aπ N => n/a ***)ππVarπ I : Integer; {loop control and Array indice }π Pivot, Idum : Integer; {holds temporary values For pivoting }π Big,Dummy : Real; {used to Compare values of each column }πbeginπ Pivot := K;π Big := Abs(Coeff_Mat1[order_Vect1[K],K]/Scale_Vect1[order_Vect1[K]]);π For I := K+1 to N doπ beginπ Dummy := Abs(Coeff_Mat1[order_Vect1[I],K]/Scale_Vect1[order_Vect1[I]]);π if Dummy > Big thenπ beginπ Big := Dummy;π Pivot := I;π end;π end;π Idum := order_Vect1[Pivot]; { switching routine }π order_Vect1[Pivot] := order_Vect1[K];π order_Vect1[K] := Idum;πend; { Procedure pivot }πππ{---------------------------------------------------------------------------}ππProcedure Eliminate(Var Col_Mat1, Scale_Vect1 : Col_Array;π Var Coeff_Mat1 : Mat_Array;π Var order_Vect1 : Int_Array;π N : Integer);πππVarπ I,J,K : Integer;π Factor : Real;ππbeginπ For K := 1 to N-1 doπ beginπ Pivot (Scale_Vect1,Coeff_Mat1,order_Vect1,K,N);π For I := K+1 to N doπ beginπ Factor := Coeff_Mat1[order_Vect1[I],K]/Coeff_Mat1[order_Vect1[K],K];π For J := K+1 to N doπ beginπ Coeff_Mat1[order_Vect1[I],J] := Coeff_Mat1[order_Vect1[I],J] -π Factor*Coeff_Mat1[order_Vect1[K],J];π end;π Col_Mat1[order_Vect1[I]] := Col_Mat1[order_Vect1[I]] - Factor*Col_Mat1[order_Vect1[K]];π end;π end;πend;πππ{---------------------------------------------------------------------------}πππProcedure Substitute(Var Col_Mat1, X_Mat1 : Col_Array;π Coeff_Mat1 : Mat_Array;π Var order_Vect1 : Int_Array;π N : Integer);ππ(*** This Procedure will backsubstitute to find the solutions to yourπ system of liNear equations.π ON ENTRY : Col_Mat => your modified Constant column matrixπ X_Mat1 => UNDEFinEDπ Coeff_Mat1 => modified into upper triangular matrixπ order_Vect => contains the order of your rowsπ N => number of equationsπ ON Exit : Col_Mat => n/aπ X_MAt1 => your solutions !!!!!!!!!!!!!π Coeff_Mat1 => n/aπ order_Vect1 => who caresπ N => n/a ***)πππVarπ I, J : Integer; (* loop and indice of Array control *)π Sum : Real; (* used to sum each row's elements *)ππbeginπ X_Mat1[N] := Col_Mat1[order_Vect1[N]]/Coeff_Mat1[order_Vect1[N],N];π (***** This gives you the value of x[n] *********)ππ For I := N-1 downto 1 doπ beginπ Sum := 0.0;π For J := I+1 to N doπ Sum := Sum + Coeff_Mat1[order_Vect1[I],J]*X_Mat1[J];π X_Mat1[I] := (Col_Mat1[order_Vect1[I]] - Sum)/Coeff_Mat1[order_Vect1[I],I];π end;πend; (** Procedure substitute **)πππ{---------------------------------------------------------------------------}πππProcedure Output(X_Mat1: Col_Array; N : Integer);ππ(*** This Procedure outputs the solutions to the inputted system of ***)π(*** equations ***)π(*** ON ENTRY : X_Mat1 => the solutions to the system of equationsπ N => the number of equationsπ ON Exit : X_Mat1 => n/aπ N => n/a ***)πππVarπ I : Integer; (* loop control and Array indice *)ππbeginπ Writeln;Writeln;Writeln; (* skips lines *)π Writeln('The solutions to your sytem of equations are:');π For I := 1 to N doπ Writeln('X(',I,') := ',X_Mat1[I]);πend; (* Procedure /output *)ππππ{---------------------------------------------------------------------------}π(* *)π(* *)π(* *)π(***************************************************************************)ππbeginππ Repeatπ Instruct; (* calls Procedure Instruct *)π Initialize_Array(Coeff_Mat, Col_Mat, X_Mat, Scale_Vect, order_Vect);π (* calls Procedure Initialize_Array *)π Repeatπ Input(N_EQNS, Coeff_Mat, Col_Mat); (* calls Procedure Input *)π Check_Input(Coeff_Mat,N_EQNS,Ans); (* calls Procedure check_Input *)π Until Ans in ['Y','y']; (* loops Until user inputs correct matrix *)ππ order(Scale_Vect,order_Vect,Coeff_Mat,N_EQNS); (* calls Procedure order *)π Eliminate(Col_Mat,Scale_Vect,Coeff_Mat,order_Vect,N_EQNS); (*etc..*)π Substitute(Col_Mat,X_Mat,Coeff_Mat,order_Vect,N_EQNS); (*etc..*)π Output(X_Mat,N_EQNS); (*etc..*)ππ Writeln;π Write('Do you wish to solve another system of equations?(Y/N):');π readln(Ans);π Until Ans in ['N','n'];πππend. (*************** end of Program GAUSS_ELIMinATION *******************)π 6 05-28-9313:50ALL SWAG SUPPORT TEAM GCD.PAS IMPORT 3 {Greatest common divisor}πProgram GCD;ππVarπ x, y : Integer;ππbeginπ read(x);ππ While x <> 0 doπ beginπ read(y);ππ While x <> y doπ if x > y thenπ x := x - yπ elseπ y := y - x;ππ Write(x);π read(x);ππ end;πend.π 7 05-28-9313:50ALL SWAG SUPPORT TEAM LOGRITHM.PAS IMPORT 2 Function NlogX(X: Real; N:Real): Real;ππbeginπ NlogX = Ln(X) / Ln(N);πend;ππ 8 05-28-9313:50ALL SWAG SUPPORT TEAM MATHSPD.PAS IMPORT 10 {π> I was just wondering how to speed up some math-intensiveπ> routines I've got here. For example, I've got a Functionπ> that returns the distance between two Objects:ππ> Function Dist(X1,Y1,X2,Y2 : Integer) : Real;π> beginπ> Dist := Round(Sqrt(Sqr(X1-X2)+Sqr(Y1-Y2)));π> end;ππ> This is way to slow. I know assembly can speed it up, butπ> I know nothing about as. so theres the problem. Pleaseπ> help me out, any and all source/suggestions welcome!ππX1, Y1, X2, Y2 are all Integers. Integer math is faster than Real (justπabout anything is). Sqr and Sqrt are not Integer Functions. Try forπfun...π}ππFunction Dist( X1, Y1, X2, Y2 : Integer) : Real;πVarπ XTemp,π YTemp : Integer;π{ the allocation of these takes time. if you don't want that time taken,π make them global With care}πbeginπ XTemp := X1 - X2;π YTemp := Y1 - Y2;π Dist := Sqrt(XTemp * XTemp + YTemp * YTemp);πend;ππ{πif you have a math coprocessor or a 486dx, try using DOUBLE instead ofπReal, and make sure your compiler is set to compile For 287 (or 387).π}ππbeginπ Writeln('Distance Between (3,9) and (-2,-3) is: ', Dist(3,9,-2,-3) : 6 : 2);πend. 9 05-28-9313:50ALL SWAG SUPPORT TEAM PARSMATH.PAS IMPORT 19 │I'm writing a Program that draws equations. It's fairly easy if you putπ│the equation in a pascal Variable like Y := (X+10) * 2, but I would likeπ│the user to enter the equation, but I don't see any possible way to doπ│it.πππ ...One way of doing it is by using an "expression trees". Supposeπyou have the equation Y := 20 ÷ 2 + 3. In this equation, you can representπthe expression 20 ÷ 2 + 3 by using "full" binary trees as such:πππfigure 1 a ┌─┐π │+│ <----- root of your expressionπ └─┘π b / \π ┌─┐ ┌─┐ eπ │÷│ │3│π └─┘ └─┘π / \π c ┌──┐ ┌─┐ dπ │20│ │2│π └──┘ └─┘πππ(Note: a "leaf" is a node With no left or right children - ie: a value )ππ...The above expression are called infix arithmetic expressions; theπoperators are written in between the things on which they operate.ππIn our example, the nodes are visited in the order c, d, b, e, a, andπtheir Labels in this order are 20, 2, ÷, 3, +.πππFunction Evaluate(p: node): Integer;π{ return value of the expression represented by the tree With root p }π{ p - points to the root of the expression tree }πVarπ T1, T2: Integer;π op: Char;πbeginπ if (p^.left = nil) and (p^.right = nil) then { node is a "leaf" }π Evaluate := (p^.Value) { simple Case }π elseπ beginπ T1 := Evaluate(p^.Left);π T2 := Evaluate(p^.Right);π op := p^.Label;π { apply operation }π Case op ofπ '+': Evaluate := (T1 + T2);π '-': Evaluate := (T1 - T2);π '÷': Evaluate := (T1 div T2);π '*': Evaluate := (T1 * T2);π end;π endπend;πππ...Thus, using figure 1, we have:ππ ┌── ┌──π │ │ Evaluate(c) = 20π │ Evaluate(b) │ Evaluate(d) = 2π │ │ ApplyOp('÷',20,2) = 10π Evaluate(a)│ └──π │ Evaluate(e) = 3π │π │ ApplyOp('+',10,3) = 13π └─π 10 05-28-9313:50ALL SWAG SUPPORT TEAM PERMUTA1.PAS IMPORT 8 {π> Does anyone have an idea to perform permutations With pascal 7.0 ?π> As an example finding the number of 5 card hands from a total of 52 cards.π> Any help would be greatly appreciated.ππThis Program should work fine. I tested it a few times and it seemed to work.πIt lets you call the Functions For permutation and combination just as youπwould Write them: P(n,r) and C(n,r).π}ππ{$E+,N+}πProgram CombPerm;ππVarπ Result:Extended;πFunction Factorial(Num: Integer): Extended;πVarπ Counter: Integer;π Total: Extended;πbeginπ Total:=1;π For Counter:=2 to Num doπ Total:=Total * Counter;π Factorial:=Total;πend;ππFunction P(N: Integer; R: Integer): Extended;πbeginπ P:=Factorial(N)/Factorial(N-R);πend;ππFunction C(N: Integer; R: Integer): Extended;πbeginπ C:=Factorial(N)/(Factorial(N-R)*Factorial(R));πend;ππbeginπ Writeln(P(52,5));πend. 11 05-28-9313:50ALL SWAG SUPPORT TEAM PERMUTA2.PAS IMPORT 18 {πI'm working on some statistical process control Charts and amπlearning/using Pascal. The current Chart Uses permutations andπI have been successful in determing the number of combinationsπpossible, but I want to be able to choose a few of those possibleπcombinations at random For testing purposes.ππThrough some trial and error, I've written the following Programπwhich calculates the number of possible combinations of x digitsπwith a certain number of digits in each combination. For exampleπa set of 12 numbers With 6 digits in each combination gives anπanswer of 924 possible combinations. After all that, here is theπquestion: Is there a Formula which would calculate what those 924πcombinations are? (ie: 1,2,3,4,5,6 then 1,2,3,4,5,7 then 1,2,3,4,5,8π... 1,2,3,4,5,12 and so on? Any help would be appreciated and anyπcriticism will be accepted.π}ππProgram permutations;ππUses Crt;ππType hold_em_here = Array[1..15] of Integer;ππVar numbers,combs,bot2a : Integer;π ans,top,bot1,bot2b : Real;π hold_Array : hold_em_here;ππFunction permutate_this(number1 : Integer) : Real;πVar i : Integer;π a : Real;πbeginπ a := number1;π For i := (number1 - 1) doWNto 1 do a := a * i;π permutate_this := a;πend;ππProcedure input_numbers(Var hold_Array : hold_em_here; counter : Integer);πVar i,j : Integer;πbeginπ For i := 1 to counter do beginπ Write(' Input #',i:2,': ');π READLN(j);π hold_Array[i] := j;π end;πend;ππProcedure show_numbers(hold_Array : hold_em_here; counter : Integer);πVar i,j : Integer;πbeginπ WriteLN;π Write('Array looks like this: ');π For i := 1 to counter do Write(hold_Array[i]:3);π WriteLNπend;ππbeginπ ClrScr;π WriteLN;π WriteLN(' Permutations');π WriteLN;π Write(' Enter number of digits (1-15): ');π READLN(numbers);π Write('Enter number in combination (2-10): ');π READLN(combs);π top := permutate_this(numbers);π bot1 := permutate_this(combs);π bot2a := numbers - combs;π bot2b := permutate_this(bot2a);π ans := top/(bot1*bot2b);π WriteLN(' total permutations For above is: ',ans:3:0);π WriteLN;π input_numbers(hold_Array,numbers);π show_numbers(hold_Array,numbers);πEND. 12 05-28-9313:50ALL SWAG SUPPORT TEAM PERMUTA3.PAS IMPORT 25 {π> I want to create all permutations.ππ Okay. I should have first asked if you Really mean permutaions.π Permutations mean possible orders. I seem to recall your orginal messageπ had to do With card hands. They usually involve combinations, notπ permutations. For example, all possible poker hands are the COMBinATIONSπ of 52 cards taken 5 at a time. Bridge hands are the combinations of 52π cards taken 13 at a time. if you master the following Program, you shouldπ be able to figure out how to create all combinations instead ofπ permutations.ππ However, if you mean permutations, here is an example Program to produceπ permutations. (You will have to alter it to your initial conditions.) Itπ involves a recursive process (a process which Uses itself). Recursiveπ processes are a little dangerous. It is easy to step on your ownπ privates writing them. They also can use a lot of stack memory. Youπ ought to be able to take the same general methods to produceπ combinations instead of permutations if need be.ππ I suggest you Compile and run the Program and see all the permutationsπ appear on the screen beFore reading further. (BTW, counts permutationsπ as well as producing them and prints out the count at the end.)ππ The Procedure Permut below rotates all possible items into the firstπ Array position. For each rotation it matches the item With all possibleπ permutations of the remaining positions. Permut does this by callingπ Permut For the Array of remaining positions, which is now one itemπ smaller. When the remaining Array is down to one position, only oneπ permutaion is possible, so the current Array is written out as one ofπ the results.ππ Once you get such a Program working, it is theoretically possible toπ convert any recursive Program to a non-recursive one. This often runsπ faster. Sometimes the conversion is not easy, however.ππ One final caution. The following Program Writes to the screen. You willπ see that as the number of items increases, the amount of outputπ increases tremendously. if you were to alter the Program to Writeπ results to a File and to allow more than 9 items, you could easilyπ create a File as big as your hard drive.π}ππProgram Permutes;ππUsesπ Crt;ππTypeπ TArry = Array[1..9] of Byte;ππVarπ Arry : TArry;π Size,X : Word;π NumbofPermutaions : LongInt;ππProcedure Permut(Arry : TArry; Position,Size : Word);πVarπ I,J : Word;π Swap: Byte;πbeginπ if Position = Size thenπ{ beginπ For I := 1 to Size doπ Write(Arry[I]:1);π} inc(NumbofPermutaions)π{ Writelnπ endπ} elseπ beginπ For J := Position to Size doπ beginπ Swap := Arry[J];π Arry[J] := Arry[Position];π Arry[Position] := Swap;π Permut(Arry,Position+1,Size)π endπ endπend;ππbeginπ ClrScr;π Write('How many elements (1 to 9)? ');π readln(Size);π ClrScr;π For X := 1 to Size doπ Arry[X] := X; {put item values in Array}π NumbofPermutaions := 0;π Permut(Arry,1,Size);π Writeln;π Writeln('Number of permutations = ',NumbofPermutaions);π Writeln('Press <Enter> to Exit.');π readlnπend.π 13 05-28-9313:50ALL SWAG SUPPORT TEAM PERMUTA4.PAS IMPORT 5 {π> Does anyone have an idea to perForm permutations With pascal 7.0 ?π> As an example finding the number of 5 card hands from a total of 52 carπ> Any help would be greatly appreciated.ππ}ππFunction Permutation(things, atatime : Word) : LongInt;πVarπ i : Word;π temp : LongInt;πbeginπ temp := 1;π For i := 1 to atatime doπ beginπ temp := temp * things;π dec(things);π end;π Permutation := temp;πend;ππbeginπ Writeln('7p7 = ',Permutation(7,7));πend. 14 05-28-9313:50ALL SWAG SUPPORT TEAM PERMUTA5.PAS IMPORT 11 {π>it. While I'm at it, does anyone have any ideas For an algorithm to generateπ>and test all possible combinations of a group of letters For Real Words.ππI'm sure it wouldn't take long to modify this Program I wrote, whichπproduces all combinations of "n" numbers.ππI got the idea from "Algorithms", by Robert Sedgewick. Recommended.π}πProgram ShowPerms;ππUsesπ Crt;ππConstπ digits = 4; {How many digits to permute: n digits = n! perms!}ππVarπ PermArray : Array [1..digits] of Byte; {Permutation holder}π ThisDigit : Integer;ππProcedure WritePerm;πVarπ loop : Byte;πbeginπ For loop := 1 to 4 doπ Write(PermArray[loop]);π Writeln;πend;ππProcedure PermuteAtLevel(Level : Integer);πVarπ loop : Integer;ππbeginπ inc(ThisDigit);π PermArray[Level] := ThisDigit;π if ThisDigit = digits thenπ Writeperm; {if we've accounted For all digits}π For loop := 1 to digits doπ if PermArray[loop] = 0 thenπ PermuteAtLevel(loop);π dec(ThisDigit);π PermArray[Level] := 0;πend;ππbeginπ ClrScr;π ThisDigit := -1; {Left of Left-hand-side}π FillChar (PermArray, sizeof(PermArray),#0); {Make it zeroes}π PermuteAtLevel(0); {Start at the bottom}πend.π- 15 05-28-9313:50ALL SWAG SUPPORT TEAM PI1.PAS IMPORT 13 {$N+}ππProgram CalcPI(input, output);ππ{ Not the most efficient Program I've ever written. Mostly it's quick andπ dirty. The infinite series is very effective converging very quickly.π It's much better than Pi/4 = 1 - 1/3 + 1/5 - 1/7 ... which convergesπ like molasses. }ππ{ Pi / 4 = 4 * (1/5 - 1/(3*5^3) + 1/(5*5^5) - 1/(7*5^7) + ...) -π (1/239 - 1/(3*239^3) + 1/(5*239^5) - 1/(7*239^7) + ...) }ππ{* Infinite series courtesy of Machin (1680 - 1752). I found it in myπ copy of Mathematics and the Imagination by Edward Kasner andπ James R. Newman (Simon and Schuster, New York 1940, p. 77) * }ππUsesπ Crt;πππVarπ Pi_Fourths,π Pi : Double;π Temp : Double;π ct : Integer;π num : Integer;πππFunction Power(Number, Exponent : Integer) : double;πVarπ ct : Integer;π temp : double;ππbeginπ temp := 1.00;π For ct := 1 to Exponent DOπ temp := temp * number;π Power := tempπend;ππbeginπ ClrScr;π ct := 1;π num := 1;π Pi_Fourths := 0;ππ While ct < 15 DOπ beginπ Temp := (1.0 / (Power(5, num) * num)) * 4;ππ if ct MOD 2 = 1 thenπ Pi_Fourths := Pi_Fourths + Tempπ ELSEπ Pi_Fourths := Pi_Fourths - Temp;ππ Temp := 1.0 / (Power(239, num) * num);ππ if ct MOD 2 = 1 thenπ Pi_Fourths := Pi_Fourths - Tempπ ELSEπ Pi_Fourths := Pi_Fourths + Temp;ππ ct := ct + 1;π num := num + 2;π end;ππ Pi := Pi_Fourths * 4.0;π Writeln( 'PI = ', Pi);πend.π 16 05-28-9313:50ALL SWAG SUPPORT TEAM PI2.PAS IMPORT 26 {π Here's a good (but a little slow) Program to calculate theπ decimals of Pi :πππTHIS Program CompUTES THE DIGITS of PI USinG THE ARCTANGENT ForMULAπ(1) PI/4 = 4 ARCTAN 1/5 - ARCTAN 1/239πin CONJUNCTION With THE GREGorY SERIESππ(2) ARCTAN X = SUM (-1)^N*(2N + 1)^-1*X^(2N+1) N=0 to inFinITY.ππSUBSTITUTinG into (2) A FEW VALUES of N and NESTinG WE HAVE,ππPI/4 = 1/5[4/1 + 1/25[-4/3 + 1/25[4/5 + 1/25[-4/7 + ...].].]ππ - 1/239[1/1 + 1/239^2[-1/3 + 1/239^2[1/5 + 1/239^2[-1/7 +...].].]ππUSinG THE LONG divISION ALGorITHM, THIS ( NESTED ) inFinITE SERIES CAN BEπUSED to CALCULATE PI to A LARGE NUMBER of DECIMAL PLACES in A REASONABLEπAMOUNT of TIME. A TIME Function IS inCLUDED to SHOW HOW SLOW THinGSπGET WHEN N IS LARGE. IMPROVEMENTS CAN BE MADE BY CHANGinG THE SIZE ofπTHE Array ELEMENTS HOWEVER IT GETS A BIT TRICKY.ππ}ππUsesπ Crt;ππVarπ B,C,V,P1,S,K,N,I,J,Q,M,M1,X,R,D : Integer;π P,A,T : Array[0..5000] of Integer;ππConst F1=5;πConst F2=239;πProcedure divIDE(D : Integer);π beginπ R:=0;π For J:=0 to M doπ beginπ V:= R*10+P[J];π Q:=V div D;π R:=V Mod D;π P[J]:=Q;π end;πend;πProcedure divIDEA(D : Integer);π beginπ R:=0;π For J:=0 to M doπ beginπ V:= R*10+A[J];π Q:=V div D;π R:=V Mod D;π A[J]:=Q;π end;π end;πProcedure SUBT;πbeginπB:=0;πFor J:=M Downto 0 doπ if T[J]>=A[J] then T[J]:=T[J]-A[J] elseπ beginπ T[J]:=10+T[J]-A[J];π T[J-1]:=T[J-1]-1;π end;πFor J:=0 to M doπA[J]:=T[J];πend;πProcedure SUBA;πbeginπFor J:=M Downto 0 doπ if P[J]>=A[J] then P[J]:=P[J]-A[J] elseπ beginπ P[J]:=10+P[J]-A[J];π P[J-1]:=P[J-1]-1;π end;πFor J:= M Downto 0 doπA[J]:=P[J];πend;πProcedure CLEARP;π beginπ For J:=0 to M doπ P[J]:=0;π end;πProcedure ADJUST;πbeginπP[0]:=3;πP[M]:=10;πFor J:=1 to M-1 doπP[J]:=9;πend;ππProcedure ADJUST2;πbeginπP[0]:=0;πP[M]:=10;πFor J:=1 to M-1 doπP[J]:=9;πend;ππProcedure MULT4;π beginπ C:=0;π For J:=M Downto 0 doπ beginπ P1:=4*A[J]+C;π A[J]:=P1 Mod 10;π C:=P1 div 10;π end;π end;ππProcedure SAVEA;πbeginπFor J:=0 to M doπT[J]:=A[J];πend;ππProcedure TERM1;πbeginπ I:=M+M+1;π A[0]:=4;πdivIDEA(I*25);πWhile I>3 doπbeginπI:=I-2;πCLEARP;πP[0]:=4;πdivIDE(I);πSUBA;πdivIDEA(25);πend;πCLEARP;πADJUST;πSUBA;πdivIDEA(5);πSAVEA;πend;πProcedure TERM2;πbeginπ I:=M+M+1;π A[0]:=1;πdivIDEA(I);πdivIDEA(239);πdivIDEA(239);πWhile I>3 doπbeginπI:=I-2;πCLEARP;πP[0]:=1;πdivIDE(I);πSUBA;πdivIDEA(239);πdivIDEA(239);πend;πCLEARP;πADJUST2;πSUBA;πdivIDEA(239);πSUBT;πend;ππ{MAin Program}ππ beginπ ClrScr;π WriteLn(' THE CompUTATION of PI');π WriteLn(' -----------------------------');π WriteLn('inPUT NO. DECIMAL PLACES');π READLN(M1);π M:=M1+4;π For J:=0 to M doπ beginπ A[J]:=0;π T[J]:=0;π end;π TERM1;π TERM2;π MULT4;π WriteLn;WriteLn;π Write('PI = 3.');π For J:=1 to M1 doπ beginπ Write(A[J]);π if J Mod 5 =0 then Write(' ');π if J Mod 50=0 then Write(' ');π end;π WriteLn;WriteLn;π WriteLn;πend.π 17 05-28-9313:50ALL SWAG SUPPORT TEAM PRIMES1.PAS IMPORT 12 {πSAM HASINOFFππLoopNum forget who first asked this question, but here is some code to helpπyou find your prime numbers in its entirety (tested):π}ππUsesπ Crt;ππLabelπ get_out;πVarπ LoopNum,π Count,π MinPrime,π MaxPrime,π PrimeCount : Integer;π Prime : Boolean;π max : String[20];π ECode : Integer;πbeginπ minprime := 0;π maxprime := 0;ππ ClrScr;π Write('Lower limit For prime number search [1]: ');π readln(max);π val(max, minprime, ECode);ππ if (minprime < 1) thenπ minprime := 1;π Repeatπ GotoXY(1, 2);π ClrEol;π Write('Upper limit: ');π readln(max);π val(max, maxprime, ECode);π Until (maxprime > minprime);ππ WriteLn;π PrimeCount := 0;ππ For LoopNum := minprime to maxprime doπ beginπ prime := True;π Count := 2;ππ While (Count <= (LoopNum div 2)) and (Prime) doπ beginπ if (LoopNum mod Count = 0) thenπ prime := False;π Inc(Count);π end;ππ if (Prime) thenπ beginπ Write('[');π TextColor(white);π Write(LoopNum);π TextColor(lightgray);π Write('] ');π Inc(PrimeCount);π if WhereX > 75 thenπ Write(#13#10);π end;π if WhereY = 24 thenπ beginπ Write('-- More --');π ReadKey;π ClrScr;π end;π prime := False;π end;π Write(#13#10#10);π Writeln(PrimeCount, ' primes found.', #13#10);πend.π 18 05-28-9313:50ALL SWAG SUPPORT TEAM PRIMES2.PAS IMPORT 9 {πBRIAN PAPEππ> Go to the library and look up the Sieve of Eratosthenes; it's a veryπ>interesting and easy method For "finding" prime numbers in a certainπ>range - and kinda fun to Program in Pascal, I might add...π}ππProgram aristophenses_net;π{π LCCC Computer Bowl November 1992 Team members:π Brian Pape, Mike Lazar, Brian Grammer, Kristy Reed - total time: 5:31π}ππConstπ size = 5000;πVarπ b : Array [1..size] of Boolean;π i, j,π count : Integer;ππbeginπ count := 0;π Writeln;π Write('WORKING: ', ' ' : 6, '/', size : 6);π For i := 1 to 13 doπ Write(#8);π fillChar(b, sizeof(b), 1);ππ For i := 2 to size doπ if b[i] thenπ beginπ Write(i : 6, #8#8#8#8#8#8);π For j := i + 1 to size doπ if j mod i = 0 thenπ b[j] := False;π end; { For }ππ Writeln;ππ For i := 1 to size doπ if b[i] thenπ beginπ Write(i : 8);π inc(count);π end;ππ Writeln;π Write('The number of primes from 1 to ', size, ' is ', count, '.');πend.ππ 19 05-28-9313:50ALL SWAG SUPPORT TEAM PRIMES3.PAS IMPORT 40 {π Hi, to All:ππ ...While recently "tuning up" one of my Programs I'm currentlyπ working on, I ran a little test to Compare the perfomanceπ of the different versions of Turbo Pascal from 5.0 throughπ to 7.0. The results were quite suprizing, and I thought I'dπ share this With you guys/gals.ππ Here are the results of a "sieve" Program to find all the primesπ in 1 - 100,000, running on my AMI 386SX-25 CPU desktop PC:ππ CompILER EXECUTION TIME RELATIVE TIME FACtoRπ ==================================================π TP 7.0 46.7 sec 1.00π TP 6.0 137.8 sec 2.95π TP 5.5 137.5 sec 2.94π TP 5.0 137.6 sec 2.95ππ Running the same Program to find all the primes in 1 - 10,000,π running on my 8086 - 9.54 Mhz NEC V20 CPU laptop PC:ππ CompILER EXECUTION TIME RELATIVE TIME FACtoRπ ==================================================π TP 7.0 14.1 sec 1.00π TP 6.0 28.3 sec 2.00ππ notE: This would seem to indicate that the TP 7.0 386 math-π library is kicking in when run on a 386 CPU.ππ Here is the source-code to my "seive" Program:π------------------------------------------------------------------------π}π {.$DEFinE DebugMode}π {$DEFinE SaveData}ππ {$ifDEF DebugMode}π {$ifDEF VER70}π {$ifDEF DPMI}π {$A+,B-,D+,E-,F-,G-,I+,L+,N-,P+,Q+,R+,S+,T+,V+,X-}π {$else}π {$A+,B-,D+,E-,F-,G-,I+,L+,N-,O-,P+,Q+,R+,S+,T+,V+,X-}π {$endif}π {$else}π {$ifDEF VER60}π {$A+,B-,D+,E-,F-,G-,I+,L+,N-,O-,R+,S+,V+,X-}π {$else}π {$A+,B-,D+,E-,F-,I+,L+,N-,O-,R+,S+,V+}π {$endif}π {$endif}π {$else}π {$ifDEF VER70}π {$ifDEF DPMI}π {$A+,B-,D-,E-,F-,G-,I-,L-,N-,P-,Q-,R-,S+,T-,V-,X-}π {$else}π {$A+,B-,D-,E-,F-,G-,I-,L-,N-,O-,P-,Q-,R-,S+,T-,V-,X-}π {$endif}π {$else}π {$ifDEF VER60}π {$A+,B-,D-,E-,F-,G-,I-,L-,N-,O-,R-,S+,V-,X-}π {$else}π {$A+,B-,D-,E-,F-,I-,L-,N-,O-,R-,S+,V-}π {$endif}π {$endif}π {$endif}ππ (* Find prime numbers - Guy McLoughlin, 1993. *)πProgram Find_Primes;ππ (***** Check if a number is prime. *)π (* *)π Function Prime({input } lo_in : LongInt) : {output} Boolean;π Varπ lo_Stop,π lo_Loop : LongInt;π beginπ if (lo_in mod 2 = 0) thenπ beginπ Prime := (lo_in = 2);π Exitπ end;π if (lo_in mod 3 = 0) thenπ beginπ Prime := (lo_in = 3);π Exitπ end;ππ if (lo_in mod 5 = 0) thenπ beginπ Prime := (lo_in = 5);π Exitπ end;π lo_Stop := 7;π While ((lo_Stop * lo_Stop) <= lo_in) doπ inc(lo_Stop, 2);π lo_Loop := 7;π While (lo_Loop < lo_Stop) doπ beginπ inc(lo_Loop, 2);π if (lo_in mod lo_Loop = 0) thenπ beginπ Prime := False;π Exitπ endπ end;π Prime := Trueπ end; (* Prime. *)ππ (***** Check For File IO errors. *)π (* *)π Procedure CheckIOerror;π Varπ by_Error : Byte;π beginπ by_Error := ioresult;π if (by_Error <> 0) thenπ beginπ Writeln('File Error = ', by_Error);π haltπ endπ end; (* CheckIOerror. *)ππVarπ bo_Temp : Boolean;π wo_PrimeCount : Word;π lo_Temp,π lo_Loop : LongInt;π fite_Data : Text;ππbeginπ lo_Temp := 100000;π {$ifDEF SaveData}π {$ifDEF VER50}π assign(fite_Data, 'PRIME.50');π {$endif}π {$ifDEF VER55}π assign(fite_Data, 'PRIME.55');π {$endif}π {$ifDEF VER60}π assign(fite_Data, 'PRIME.60');π {$endif}π {$ifDEF VER70}π assign(fite_Data, 'PRIME.70');π {$endif}π {$I-}π reWrite(fite_Data);π {$I+}π CheckIOerror;π {$endif}π wo_PrimeCount := 0;π For lo_Loop := 2 to lo_Temp doπ if Prime(lo_Loop) thenπ {$ifDEF SaveData}π beginπ Write(fite_Data, lo_Loop:6);π Write(fite_Data, ', ');π inc(wo_PrimeCount);π if ((wo_PrimeCount mod 10) = 0) thenπ Writeln(fite_Data)π end;π close(fite_Data);π CheckIOerror;π {$else}π inc(wo_PrimeCount);π {$endif}π Writeln(wo_PrimeCount, ' primes between: 1 - ', lo_Temp)πend.ππ{π ...This little test would put TP 7.0's .EXE's between 2 to 3π times faster than TP4 - TP6 .EXE's. (I've found simmilar resultsπ in testing other Programs I've written.) I guess this is one moreπ reason to upgrade to TP 7.0 .ππ ...I'd be curious to see how StonyBrook's Pascal+ 6.1 Comparesπ to TP 7.0, in terms of execution speed With this Program.ππ - Guyπ}π 20 05-28-9313:50ALL SWAG SUPPORT TEAM SQRT.PAS IMPORT 13 (***** Find the square-root of an Integer between 1..2,145,635,041 *)π(* *)πFunction FindSqrt({input} lo_in : LongInt) : {output} LongInt;ππ (***** SUB : Find square-root For numbers less than 65417. *)π (* *)π Function FS1({input } wo_in : Word) : {output} Word;π Varπ wo_Temp : Word;π beginπ wo_Temp := 1;π While ((wo_Temp * wo_Temp) < wo_in) doπ inc(wo_Temp, 11);π While((wo_Temp * wo_Temp) > wo_in) doπ dec(wo_Temp);π FS1 := wo_Tempπ end; (* SUB : FS1. *)ππ (***** SUB : Find square-root For numbers greater than 65416. *)π (* *)π Function FS2(lo_in : LongInt) : LongInt;π Varπ lo_Temp : LongInt;π beginπ lo_Temp := 1;π While ((lo_Temp * lo_Temp) < lo_in) doπ inc(lo_Temp, 24);π While((lo_Temp * lo_Temp) > lo_in) doπ dec(lo_Temp);π FS2 := lo_Tempπ end; (* SUB : FS2. *)ππbeginπ if (lo_in < 64517) thenπ FindSqrt := FS1(lo_in)π elseπ FindSqrt := FS2(lo_in)πend; (* FindSqrt. *)ππ{π ...I've now re-written the "seive" Program, and it appears to nowπ run about twice as fast. I'll post the new improved source-code inπ another message.π}
